HPAVC/HPAVC CD-ROM.iso/MYMUD21.ZIP/MMUD21.ZIP/SOURCE/SOURCE.ZIP/META_DO.PAS

Pascal/Delphi Source File | 1995-01-21 | 32KB | 1,123 lines

{$I COPYRGHT.INC}

(*---------------------------------------------------------------------------*
  This unit contains all meta commands used in the game. (The commands which
  start with an @.
 *---------------------------------------------------------------------------*)

Unit Meta_Do;
Interface
Uses MyIO,     { For the READKEY in the Meta_Make_Text procedure! }
{|}  Dos,
     Misc,
     Header,
     LowLevel,
     Multi,
     BIN_DB;

(*---------------------------------------------------------------------------*
  Set a new lock on an object. Use 'ME' to lock yourself.
*---------------------------------------------------------------------------*)
Procedure Meta_Set_Lock(Current : ContextType;InpStr : String);
Procedure Meta_UnLock(Current : ContextType;InpStr : String);

(*---------------------------------------------------------------------------*
  Accept a text of max. 1023 characters and store it. Which can be:

    0 - DESC
    1 - FAIL       3 - OFAIL
    2 - SUCCESS    4 - OSUCCESS
    5 - MACRO
    6 - FINGER
 *---------------------------------------------------------------------------*)
Procedure Meta_Make_Text(Current : ContextType;InpStr : String;Which : Byte);

(*---------------------------------------------------------------------------*
  Meta_ChangePassword Changes the user's password. InpStr should be of the
                    form <oldpassword>=<newpassword>
 *---------------------------------------------------------------------------*)
Procedure Meta_ChangePassword(Current : ContextType;InpStr : String);

(*---------------------------------------------------------------------------*
  Meta_SetFlag Sets or resets a flag.
 *---------------------------------------------------------------------------*)
Procedure Meta_SetFlag(Current : ContextType;InpStr : String);

(*---------------------------------------------------------------------------*
  Meta_CreateObj, creates a new THING object
  Meta_HomeHere  sets the object its home to the current location.
  Meta_ChangeHome changes the homelocation for playes, drones and things.
 *---------------------------------------------------------------------------*)
Procedure META_CreateObj(Current : ContextType;InpStr : String);
Procedure META_HomeHere(Current : ContextType;InpStr : String);
Procedure Meta_ChangeHome(Current : ContextType;InpStr : String);

(*---------------------------------------------------------------------------*
   Meta_ChangeName changes the name of an object.
 *---------------------------------------------------------------------------*)
Procedure Meta_ChangeName(Current : ContextType;InpStr : String);

(*---------------------------------------------------------------------------*
  Increase the level of a player with a status lower than your own.
 *---------------------------------------------------------------------------*)
Procedure Meta_Change_Level(Current : ContextType;InpStr : String;Diff : Integer);

(*---------------------------------------------------------------------------*
  Change the ownership of an object
 *---------------------------------------------------------------------------*)
Procedure Meta_ChOwn(Current : ContextType; InpStr : String);

(*---------------------------------------------------------------------------*
  Meta_Dig       Basic digging command
  Meta_OpenLink  Creates a new link
 *---------------------------------------------------------------------------*)
Procedure META_Dig(Current : ContextType;InpStr : String);
Procedure Meta_OpenLink(Current : ContextType;InpStr : String);
Procedure Meta_Action(Current : ContextType;InpStr : String);

(*---------------------------------------------------------------------------*
  Find all object owner by a user.
 *---------------------------------------------------------------------------*)
Procedure Meta_Find(Current : ContextType;InpStr : String);

(*---------------------------------------------------------------------------*
  Teleport to a place, player or object
 *---------------------------------------------------------------------------*)
Procedure Meta_Teleport(Current : ContextType;InpStr : String);

(*---------------------------------------------------------------------------*
  See the inforecord of an other player.
 *---------------------------------------------------------------------------*)
Procedure Meta_Finger(Current : ContextType;InpStr : String);

(*---------------------------------------------------------------------------*
  Destroy an object and connect it to the garbage chain.
 *---------------------------------------------------------------------------*)
Procedure Meta_Destroy(Current : ContextType;InpStr : String);

(*---------------------------------------------------------------------------*
  Edit an external file.
 *---------------------------------------------------------------------------*)
Procedure Meta_Edit(Current : ContextType;InpStr : String);



Implementation
Uses Norm_do;


(*--------------------------------------------------------------------------*)
Procedure Meta_ChangePassword(Current : ContextType;InpStr : String);
Var NewPass : PassString;
Begin
InpStr:=UpStr(InpStr);

If Not SplitCommand(InpStr,InpStr,NewPass)
   Then Begin
        My_WriteLn('Use @PASSWORD <OldPassword>=<NewPassword>');
        Exit;
        End;

Lock('Password');
Current.DB.ReadObj(Current.Player);
If UpStr(InpStr)<>UpStr(Current.DB.ObjRec.Password)
   Then Begin
        My_WriteLn('Incorrect password.');
        Unlock;
        Exit;
        End;
Current.DB.ObjRec.Password:=NewPass;
Current.DB.UpdateObj(Current.Player);
Unlock;

My_WriteLn('Password successful updated');
End;

(*--------------------------------------------------------------------------*)

Procedure Meta_SetFlag(Current : ContextType;InpStr : String);
Var ObjNr    : Integer;
    Action   : String;
    Negate   : Boolean;
Begin
InpStr:=UpStr(inpStr);
If Not SplitCommand(InpStr,InpStr,Action)
   Then Begin
        My_WriteLn('Syntax: @SET <Obj>=[!]<FLAG>');
        Exit;
        End;

ObjNr:=Str2ObjNr(Current,InpStr);
If ObjNr=NOTHING
   Then Begin
        My_WriteLn('You don''t have that object.');
        Exit;
        End;

Lock('Set flags');
Current.DB.ReadObj(ObjNr);
If (Current.Level<Wizard_Level) And
   (Not (Current.DB.IsThing or Current.DB.IsRoom))
   Then Begin
        My_WriteLn('You can only set flags for things and rooms.');
        Unlock;
        Exit;
        End;

If (Not Current.DB.IsOwner(Current.Player)) And
   (Current.Level<Wizard_Level)
   Then Begin
        My_WriteLn('You don''t own '+Current.DB.Name);
        Unlock;
        Exit;
        End;

Negate:=Action[1]='!';
If Negate
   Then Delete(Action,1,1);
With Current.DB.ObjRec Do
 Begin
 Case Upcase(Action[1]) Of
   'T' : If Not Negate Then SetBit(Room_Flags,Temple_Room)
                       Else ResetBit(Room_Flags,Temple_Room);

   'H' : If Not Negate Then SetBit(Room_Flags,Haven_Room)
                       Else ResetBit(Room_Flags,Haven_Room);

   '$' : If Not Negate Then SetBit(Room_Flags,Shop_Room)
                       Else ResetBit(Room_Flags,Shop_Room);

   'O' : If Not Negate Then SetBit(Room_Flags,Loud_Room)
                       Else ResetBit(Room_Flags,Loud_Room);


   'C' : If Not Negate Then SetBit(Attr_Flags,Chown_Ok_Flag)
                       Else ResetBit(Attr_Flags,ChOwn_Ok_Flag);

   'L' : If Not Negate Then SetBit(Attr_Flags,Link_Ok_Flag)
                       Else ResetBit(Attr_Flags,Link_Ok_Flag);

   'S' : If Not Negate Then SetBit(attr_Flags,Sticky_Flag)
                       Else ResetBit(Attr_Flags,Sticky_Flag);

   'I' : If Not Negate Then SetBit(Attr_Flags,Invisible_Flag)
                       Else ResetBit(Attr_Flags,Invisible_Flag);

   'P' : If Not Negate Then SetBit(Attr_Flags,Teleport_Ok_Flag)
                       Else ResetBit(Attr_Flags,Teleport_Ok_Flag);

   'D' : If Not Negate Then ObjType:=Drone_Type
                       Else ObjType:=Thing_Type;
 End; {Case}
 End; {With}
Current.DB.UpdateObj(ObjNr);
Unlock;
End;


(*--------------------------------------------------------------------------*)
Procedure Meta_Set_Lock(Current : ContextType;InpStr : String);
Var LockObj : String;
    ObjNr   : Integer;
Begin
If InpStr=''
   Then Exit;

InpStr:=UpStr(InpStr);
If Not SplitCommand(InpStr,LockObj,InpStr)
   Then Begin
        My_WriteLn('The syntax is @LOCK <object>=<key>|*');
        exit;
        End;

ObjNr:=Str2ObjNr(Current,LockObj);
If ObjNr=NOTHING
   Then Begin
        My_WriteLn('You don''t have the '+LockObj);
        Exit;
        End;

If InpStr='*'
   Then InpStr:='(ME&(!ME))';
TranslateExpression(Current,InpStr);

Lock('Update key');
Current.DB.ReadObj(ObjNr);
If (Not Current.DB.IsOwnedBy(Current.Player)) And
   (Not Current.DB.LevelOk(Wizard_Level))
   Then Begin
        My_WriteLn('You can''t lock that object!');
        Unlock;
        Exit;
        End;

Current.DB.ObjRec.Key:=InpStr;
Current.DB.UpdateObj(ObjNr);
Unlock;
My_WriteLn('Lock updated');
End;

(*--------------------------------------------------------------------------*)
Procedure Meta_UnLock(Current : ContextType;InpStr : String);
Var ObjNr   : Integer;
Begin
If InpStr=''
   Then Begin
        My_WriteLn('The syntax is @UNLOCK <object>');
        exit;
        End;

InpStr:=UpStr(InpStr);
If InpStr='ME'
   Then ObjNr:=Current.Player
   Else Begin
        Current.DB.ReadObj(Current.Player);
        ObjNr:=Str2ObjNr(Current,InpStr);
        If ObjNr=NOTHING
           Then Begin
                My_WriteLn('You don''t have the '+InpStr);
                Exit;
                End;
        End;

Lock('Update key');
Current.DB.ReadObj(ObjNr);
If (Not Current.DB.IsOwnedBy(Current.Player)) And
   (Not Current.DB.LevelOk(Wizard_Level))
   Then Begin
        My_WriteLn('You can''t unlock that object!');
        Unlock;
        Exit;
        End;

Current.DB.ObjRec.Key:='';
Current.DB.UpdateObj(ObjNr);
Unlock;
My_WriteLn('Object unlocked.');
End;

(*--------------------------------------------------------------------------*)
Procedure Meta_Make_Text(Current : ContextType;InpStr : String;Which : Byte);
Var TxtRec : TextRecord;
    BufPtr : Word;
    LRec   : LongRec;
    Stop   : Boolean;
    Key    : Char;
    RW     : Word;
    ObjNr  : Integer;
    Tmp    : File;

Begin
If InpStr=''
   Then exit;

If Which = 6
   Then ObjNr:=Current.Db.FindPlayer(InpStr)
   Else ObjNr:=NOTHING;

If ObjNr=NOTHING
   Then ObjNr:=Str2ObjNr(Current,InpStr);

If ObjNr=NOTHING
   Then Begin
        My_WriteLn('You can''t describe that!');
        Exit;
        End;

Current.DB.ReadObj(ObjNr);

If (Which=6) And
   (Current.Level<Wizard_Level) And
   (Current.Player<>ObjNr)
   Then Begin
        My_WriteLn('You can only give users an information record.');
        Exit;
        End;


If (Not Current.DB.IsOwnedBy(Current.Player)) And
   (Current.Level<Wizard_Level)
   Then Begin
        My_WriteLn('You can''t do anything with that object');
        Exit;
        End;

Case Which Of
 0 : LRec:=Current.DB.ObjRec.Desc;
 1 : LRec:=Current.DB.ObjRec.Fail;
 2 : LRec:=Current.DB.ObjRec.Success;
 3 : LRec:=Current.DB.ObjRec.OFail;
 4 : LRec:=Current.DB.ObjRec.OSuccess;
 5 : LRec:=Current.DB.ObjRec.Macro;
 6 : LRec:=Current.DB.ObjRec.Finger;
End; {Case}

If (Editor<>'')
    Then Begin
         Assign(Tmp,TempDir+'DESC.'+Nr2Str(MyNode));
         Rewrite(Tmp,1);
         If LRec.Length>0
            Then Begin
                 Seek(Current.DB.TxtFile,LRec.Start);
                 BlockRead(Current.DB.TxtFile,TxtRec[0],MaxLen(LRec.Length),RW);
                 BlockWrite(Tmp,TxtRec[0],MaxLen(LRec.Length),RW);
                 End;
         Close(Tmp);
         SwapVectors;
         Exec(Editor,TempDir+'DESC.'+Nr2Str(MyNode));
         SwapVectors;
         If (DosError<>0) Or
            (DosExitCode<>0)
            Then Begin
                 My_WriteLn('Sorry.. can''t spawn editor..');
                 My_WriteLn('Please contact god or wizards.');
                 My_WriteLn('Just try again for the buildin editor');
                 Editor:='';
                 Exit;
                 End;
         Reset(Tmp,1);
         If FileSize(Tmp)=0
            Then Begin
                 Close(Tmp);
                 Erase(tmp);
                 Exit;
                End;
         BlockRead(Tmp,TxtRec,SizeOf(TxtRec),BufPtr);
         Close(Tmp);
         Erase(Tmp);
         End

   Else Begin
        My_WriteLn('Start typing. Maximal 1023 characters. Finish with <<');
        FillChar(TxtRec,SizeOf(TxtRec),#00);
        BufPtr:=0;
        While Not Stop Do
         Begin
         Key:=My_ReadKey;
         Case Key Of
          #8 : Begin
               If BufPtr>0
                  Then Begin
                       My_Write(#8' '#8);
                       Dec(BufPtr);
                       End;
               End;
          #9  : ;
          #13 : ;
          #10 : ;
          Else Begin
               Stop:=(Upcase(Key)='<') and (BufPtr>0) And (TxtRec[BufPtr-1]='<');
               If Not Stop
                  Then Begin
                       If BufPtr>1022
                          Then My_Write(#7)
                          Else Begin
                               My_Write(Key);
                               TxtRec[BufPtr]:=Key;
                               Inc(BufPtr);
                               End;
                       End
                  Else Begin
                       Dec(BufPtr);
                       TxtRec[BufPtr]:=#00;
                       My_WriteLn('');
                       End;
               End;
          End; {Case}
          End; {While}
          End;

LRec.Length:=BufPtr;
Seek(Current.DB.TxtFile,FileSize(Current.DB.TxtFile));
LRec.Start:=FilePos(Current.DB.TxtFile);
LRec.Length:=MaxLen(BufPtr);

Lock('Updating description');
Current.DB.ReadObj(ObjNr);
BlockWrite(Current.DB.TxtFile,TxtRec[0],BufPtr,RW);
If RW<>BufPtr
   Then Begin
        My_WriteLn('!! Description not saved!');
        Unlock;
        Exit;
        End;

Case Which Of
 0 : Current.DB.ObjRec.Desc:=LRec;
 1 : Current.DB.ObjRec.Fail:=LRec;
 2 : Current.DB.ObjRec.Success:=LRec;
 3 : Current.DB.ObjRec.OFail:=LRec;
 4 : Current.DB.ObjRec.OSuccess:=LRec;
 5 : Current.DB.ObjRec.Macro:=LRec;
 6 : Current.DB.ObjRec.Finger:=LRec;
End; {Case}

Current.DB.UpdateObj(ObjNr);
Unlock;
End;

(*--------------------------------------------------------------------------*)
Procedure META_CreateObj(Current : ContextType;InpStr : String);
Var Price : Integer;
    Name  : String;
    ObjNr : Integer;
Begin
If SplitCommand(InpStr,Name,InpStr)
   Then Begin
        Price:=Str2Nr(InpStr);
        If Price=0
           Then Begin
                My_WriteLn('Creation error: incorrect price');
                Exit;
                End;
        End
   Else Begin
        Price:=10;
        Name:=InpStr;
        End;

If CleanUp(Name)=''
   Then Begin
        My_WriteLn('You have to give the thing a name.');
        Exit;
        End;

ObjNr:=Str2ObjNr(Current,Name);
If ObjNr<>NOTHING
   Then Begin
        My_WriteLn('You already have a '+Name);
        Exit;
        End;


Current.DB.ReadObj(Current.Player);
If (Not Current.DB.LevelOk(Wizard_Level)) And
   (Current.DB.ObjRec.Pennies<Price)
   Then Begin
        My_WriteLn('Sorry, you can''t affort this creation.');
        Exit;
        End;

ObjNr:=CreateNewObject(Current,Thing_Type,Name,Price);
My_WriteLn('Out of a puff of smoke you created a '+name+' (#'+Nr2Str(ObjNr)+')');
End;





(*--------------------------------------------------------------------------*)
Procedure META_HomeHere(Current : ContextType;InpStr : String);
Var ObjNr  : Integer;
Begin
If InpStr=''
   Then exit;

Current.DB.ReadObj(Current.Room);
If Not (Current.DB.IsOwner(Current.Player) or
       Current.DB.LevelOk(Wizard_Level))
   Then Begin
        My_WriteLn('You don''t own this location.');
        Exit;
        End;

ObjNr:=Str2ObjNr(Current,InpStr);
If (ObjNr=NOTHING)
   Then Begin
        My_WriteLn('You can''t have that.');
        Exit;
        End;

Lock('Home Object');
Current.DB.ReadObj(ObjNr);
If Not (Current.DB.IsOwner(Current.Player) Or
        (Current.Level>=Wizard_Level))
   Then Begin
        My_WriteLn('You don''t own '+Current.DB.Name);
        Unlock;
        Exit;
        End;
Current.DB.ObjRec.Exits:=Current.Room;
Current.DB.UpdateObj(ObjNr);
Unlock;
End;


(*--------------------------------------------------------------------------*)
Procedure Meta_ChangeName(Current : ContextType;InpStr : String);
Var ObjNr   : Integer;
    OldName : String;
Begin
If InpStr=''
   Then exit;
InpStr:=CleanUp(InpStr);
If Not SplitCommand(InpStr,OldName,InpStr)
   Then Begin
        My_WriteLn('Syntax: @NAME <OldName>=<NewName>');
        Exit;
        End;

ObjNr:=Str2ObjNr(Current,OldName);
If ObjNr=NOTHING
   Then Begin
        If Can_Move(Current,OldName)
           Then ObjNr:=ExitNr
           Else Begin
                My_WriteLn('You can''t do that!');
                Exit;
                End;
        End;

Lock('Update name');
Current.DB.ReadObj(ObjNr);
If Not (Current.DB.IsOwner(Current.Player) or
       (Current.Level>=Wizard_Level))
   Then Begin
        My_WriteLn('You don''t own that object!');
        Unlock;
        Exit;
        End;
Current.DB.ObjRec.Name:=inpStr;
Current.DB.UpdateObj(ObjNr);
Unlock;
End;

(*--------------------------------------------------------------------------*)
Procedure Meta_ChangeHome(Current : ContextType;InpStr : String);
Var ObjNr   : Integer;
    OldName : String;
    Location: Integer;
Begin
If InpStr=''
   Then exit;

InpStr:=CleanUp(InpStr);
If Pos('=',InpStr)=0
   Then InpStr:=InpStr+'=HERE';

If Not SplitCommand(InpStr,OldName,InpStr)
   Then Begin
        My_WriteLn('Syntax: @HOME <Name>[=<Location>]');
        Exit;
        End;

ObjNr:=Str2ObjNr(Current,OldName);
If ObjNr=NOTHING
   Then Begin
        My_WriteLn(OldName+' is not here.');
        Exit;
        End;

Current.DB.ReadObj(ObjNr);
If Current.DB.IsRoom or Current.DB.IsExit
   Then Begin
        My_WriteLn('You cannot change the HOME of exits or rooms.');
        Exit;
        End;

Location:=Str2Objnr(Current,InpStr);
If Location=NOTHING
   Then Begin
        My_WriteLn(InpStr+' doesn''t exist.');
        Exit;
        End;

Lock('Update name');
Current.DB.ReadObj(ObjNr);
If Not (Current.DB.IsOwner(Current.Player) or
       (Current.Level>=Wizard_Level))
   Then Begin
        My_WriteLn('You don''t own that object!');
        Unlock;
        Exit;
        End;
Current.DB.ObjRec.Exits:=Location;
Current.DB.UpdateObj(ObjNr);
Unlock;
End;


(*--------------------------------------------------------------------------*)



Procedure Meta_Change_Level(Current : ContextType;InpStr : String;Diff : Integer);
Var ObjNr : Integer;
Begin
If InpStr=''
   Then Exit;
ObjNr:=Str2ObjNr(Current,InpStr);
If ObjNr=NOTHING
   Then begin
        My_WriteLn('That user doesn''t exist.');
        Exit;
        End;

Lock('Raise level');
Current.DB.ReadObj(ObjNr);
If Not Current.DB.IsPlayer
   Then Begin
        My_WriteLn(Current.DB.Name+' is not a player.');
        Unlock;
        Exit;
        End;

If ObjNr=Current.Player
   Then Begin
        My_WriteLn('Joker!');
        Unlock;
        Exit;
        End;

{$IfNDef MakeGod}
If ((Current.DB.ObjRec.ObjLevel+Diff)>=Current.Level) or
   ((Current.DB.ObjRec.ObjLevel+Diff)<0)
   Then Begin
        My_WriteLn('You can''t promote people to a level higher or equal than your own.');
        Unlock;
        Exit;
        End;
{$EndIf}
Inc(Current.DB.ObjRec.ObjLevel,Diff);
Current.DB.UpdateObj(ObjNr);
Unlock;

My_WriteLn('Level successful changed to '+LevelNames[Current.DB.ObjRec.ObjLevel]);
SayPrivate(ObjNr,'+You are now a '++LevelNames[Current.DB.ObjRec.ObjLevel]+'.');
End;


(*--------------------------------------------------------------------------*)
Procedure Meta_ChOwn(Current : ContextType; InpStr : String);
Var ObjNr    : Integer;
    Name     : String;
    Player   : Integer;
    PlayerOk : Boolean;
Begin
If InpStr=''
   Then Exit;

InpStr:=UpStr(InpStr);


If Not SplitCommand(InpStr,InpStr,Name)
   Then Begin
        My_WriteLn('Who should own what?');
        Exit;
        End;

ObjNr:=Str2ObjNr(Current,InpStr);
If ObjNr=NOTHING
   Then Begin
        My_WriteLn('That object isn''t here.');
        Exit;
        End;

Player:=Current.DB.FindPlayer(Name);
If Player=NOTHING
   Then Begin
        My_WriteLn('There is no player with that name.');
        Exit;
        End;

Current.DB.ReadObj(Player);
PlayerOk:=Current.DB.IsChownOk or Current.DB.LevelOk(Wizard_Level);

If Not PlayerOk
   Then Begin
        My_WriteLn(Current.DB.Name+' doesn''t accept ownership of strange objects.');
        Exit;
        End;

Lock('Changing owner');
Current.DB.ReadObj(ObjNr);
If Not (Current.DB.IsOwner(Current.Player) Or
       (Current.Level>=Wizard_Level))
   Then Begin
        My_WriteLn('You don''t own that object.');
        Unlock;
        Exit;
        End;

Current.DB.ObjRec.Owner:=Player;
Current.DB.UpdateObj(ObjNr);
Unlock;
My_WriteLn('The ownership has changed.');
End;

(*--------------------------------------------------------------------------*)
Procedure Meta_CreateLink(Current : ContextType; InpStr : String);
Var Dirs  : String;
    Name  : String;
    ObjNr : Integer;
Begin
Current.DB.ReadObj(Current.Player);
If (Not Current.DB.LevelOk(Wizard_Level)) And
   (Current.DB.ObjRec.Pennies<10)
   Then Begin
        My_WriteLn('Sorry, you can''t affort a new room.');
        Exit;
        End;

ObjNr:=CreateNewObject(Current,Room_Type,Name,2);
My_WriteLn('With crashing rock you create a room called '+Name+' (#'+Nr2Str(Objnr)+')');

End;

(*--------------------------------------------------------------------------*)
Procedure DropLink( Current      : ContextType;
                    LinkNr,ObjNr : Integer;
                    Flags        : LongInt);
Var RecNr : Integer;
Begin
Lock('New link');
Current.DB.ReadObj(Current.Room);
If Current.DB.ObjRec.Exits=NOTHING
   Then Begin
        RecNr:=Current.Room;
        Current.DB.ObjRec.Exits:=LinkNr;
        End
   Else Begin
        RecNr:=Current.DB.ObjRec.Exits;
        Current.DB.ReadObj(RecNr);
        While Current.DB.ObjRec.Next<>NOTHING Do
         Begin
         RecNr:=Current.DB.ObjRec.Next;
         Current.DB.ReadObj(RecNr);
         End;
        Current.DB.ObjRec.Next:=LinkNr;
        End;

Current.DB.UpdateObj(RecNr);
Current.DB.ReadObj(LinkNr);
Current.DB.ObjRec.Location:=ObjNr;
Current.DB.ObjRec.Next:=NOTHING;
Current.DB.ObjRec.GenFlags:=Current.DB.ObjRec.GenFlags Or Flags;
Current.DB.UpdateObj(LinkNr);
Unlock;
End;


Procedure META_Dig(Current : ContextType;InpStr : String);
Var Dirs  : String;
    Name  : String;
    ObjNr : Integer;
    LinkNr: Integer;
Begin
If Not SplitCommand(InpStr,Name,Dirs)
   Then Begin
        Name:=InpStr;
        Dirs:='';
        {My_WriteLn('Syntax: @DIG <Name>=<Direction>');
        Exit;}
        End;

If CleanUp(Name)=''
   Then Begin
        My_WriteLn('You have to give the room a name.');
        Exit;
        End;

If Str2ObjNr(Current,Name)<>NOTHING
   Then Begin
        My_WriteLn('There is already an object with that name here.');
        Exit;
        End;

If Str2ObjNr(Current,Dirs)<>NOTHING
   Then Begin
        My_WriteLn('That exit is already in use.');
        Exit;
        End;

Current.DB.ReadObj(Current.Room);
If Not (Current.DB.IsLinkOk Or Current.DB.IsOwner(Current.Player))
   Then Begin
        My_WriteLn('You are not allowed to dig here..');
        Exit;
        End;

Current.DB.ReadObj(Current.Player);
If (Not Current.DB.LevelOk(Wizard_Level)) And
   (Current.DB.ObjRec.Pennies<10)
   Then Begin
        My_WriteLn('Sorry, you can''t affort a new room.');
        Exit;
        End;

ObjNr:=CreateNewObject(Current,Room_Type,Name,2);
My_WriteLn('With crashing rock you create a room called '+Name+' (#'+Nr2Str(Objnr)+')');

If Dirs<>''
   Then Begin
        My_WriteLn('Let''s see if we can link..');
        LinkNr:=CreateNewObject(Current,Exit_Type,Dirs,2);
        DropLink(Current,LinkNr,ObjNr,0);
        My_WriteLn('Linked ok.');
        Current.DB.ResetAll;
        End
   Else MoveTo(ObjNr,Current.Player);

End;

(*--------------------------------------------------------------------------*)
Procedure Meta_OpenLink(Current : ContextType;InpStr : String);
Var Name   : String;
    ObjNr  : Integer;
    LinkNr : Integer;
Begin
If InpStr=''
   Then Exit;
If Not SplitCommand(InpStr,Name,InpStr)
   Then Begin
        My_WriteLn('Syntax: @OPEN <Direction>[;<Direction>]=#<TargetRoomNr.>');
        Exit;
        End;

If Str2ObjNr(Current,Name)<>NOTHING
   Then Begin
        My_WriteLn('There is already an object with that name here.');
        Exit;
        End;


ObjNr:=Str2ObjNr(Current,InpStr);
If ObjNr=NOTHING
   Then Begin
        My_WriteLn('Couldn''t find the target room');
        Exit;
        End;

Current.DB.ReadObj(ObjNr);
If (Not Current.DB.IsLinkOk) And
   (Current.DB.ObjRec.Owner<>Current.Player)
   Then Begin
        My_WriteLn('You don''t own the target room.');
        Exit;
        End;

LinkNr:=CreateNewObject(Current,Exit_Type,Name,2);
DropLink(Current,LinkNr,ObjNr,0);
My_WriteLn('Linked.');
End;

(*--------------------------------------------------------------------------*)
Procedure Meta_Action(Current : ContextType;InpStr : String);
Var LinkNr : Integer;
Begin
If InpStr=''
   Then Exit;

If Str2ObjNr(Current,InpStr)<>NOTHING
   Then Begin
        My_WriteLn('There is already an object with that name here.');
        Exit;
        End;

Current.DB.ReadObj(Current.Room);
If Not (Current.DB.IsLinkOk and Current.DB.IsOwner(Current.Player))
   Then Begin
        My_WriteLn('You can''t link here..');
        Exit;
        End;

LinkNr:=CreateNewObject(Current,Exit_Type,InpStr,2);
DropLink(Current,LinkNr,Current.Room,0);
My_WriteLn('Action created');
End;

(*--------------------------------------------------------------------------*)
Procedure Meta_Find(Current : ContextType;InpStr : String);
Var ObjNr : Integer;
    Count : Integer;
Begin
If InpStr=''
   Then ObjNr:=Current.Player
   Else Begin
        If Current.Level>=Wizard_Level
           Then ObjNr:=Current.DB.FindPlayer(InpStr)
           Else Begin
                My_WriteLn('Huh?');
                Exit;
                End;
        End;

Lock('Pay for @FIND');
Current.DB.ReadObj(Current.Player);
If Current.DB.ObjRec.Pennies=0
   Then Begin
        My_WriteLn('Sorry, you can''t afford a @FIND.');
        Unlock;
        Exit;
        End;
Dec(Current.DB.ObjRec.Pennies);
Current.DB.UpdateObj(Current.Player);
Unlock;

My_WriteLn('Obj# Loc  Name');
My_WriteLn('---- ---- -------------------------------------------------------');
Seek(Current.DB.ObjFile,0);
Count:=0;
While Not Eof(Current.DB.ObjFile) Do
 Begin
 Current.DB.ReadObj(Count);
 If Current.DB.IsOwner(ObjNr)
    Then My_WriteLn(Nr2FStr(Count,4)+' '+Nr2FStr(Current.DB.ObjRec.Location,4)+' '+Current.DB.Name);
 Inc(Count);
 End;
My_WriteLn('');
End;

(*--------------------------------------------------------------------------*)
Procedure Meta_Teleport(Current : ContextType;InpStr : String);
Var ObjNr   : Integer;
    OldRoom : Integer;
Begin
OldRoom:=Current.Room;
If InpStr=''
   Then Begin
        My_WriteLn('Syntax: @teleport <Username>');
        Exit;
        End;

ObjNr:=Current.DB.FindPlayer(InpStr);
If (ObjNr=NOTHING)
   Then Begin
        ObjNr:=Str2ObjNr(Current,InpStr);
        If ObjNr=NOTHING
           Then Exit;
        End;

Current.DB.ReadObj(ObjNr);
If Not Current.DB.IsRoom
   Then Begin
        ObjNr:=Current.DB.ObjRec.Location;
        Current.DB.ReadObj(ObjNr);
        End;

If Not (Current.DB.IsRoom and Current.DB.CanTeleport)
   Then Begin
        My_WriteLn('Sorry, you can''t teleport there.');
        Exit;
        End;

Current.Room:=ObjNr;
MoveTo(Current.Player,Current.Room);
HandleDrones(0,Current,OldRoom);
End;

(*--------------------------------------------------------------------------*)
Procedure Meta_Finger(Current : ContextType;InpStr : String);
Var ObjNr   : Integer;
Begin
If InpStr=''
   Then Begin
        My_WriteLn('@Finger <ObjectName>');
        Exit;
        End;

ObjNr:=Current.DB.FindPlayer(InpStr);
If ObjNr=NOTHING
   Then ObjNr:=Str2ObjNr(Current,InpStr);

If ObjNr=NOTHING
   Then Begin
        My_WriteLn('Player unknown');
        Exit;
        End;

Current.DB.ReadObj(ObjNr);
Current.DB.Finger('User has no INFO description set.');
End;



Procedure Meta_Destroy(Current : ContextType;InpStr : String);
Var ObjNr   : Integer;
Begin
If InpStr=''
   Then Begin
        My_WriteLn('Syntax: @DESTROY <Name>');
        Exit;
        End;

ObjNr:=Str2ObjNr(Current,InpStr);
If ObjNr=NOTHING
   Then Begin
        My_WriteLn('You don''t have that object.');
        Exit;
        End;

Current.DB.ReadObj(ObjNr);
If (Not Current.DB.IsOwner(ObjNr)) And
   (Current.Level<Wizard_Level)
   Then Begin
        My_WriteLn('You don''t own the object.');
        Exit;
        End;

If Not Current.DB.IsThing
   Then Begin
        My_WriteLn('You can only destroy things.');
        Exit;
        End;


Current.DB.ReadObj(Current.Player);
If Current.DB.ObjRec.Garbage=0
   Then Current.DB.ObjRec.Garbage:=0;
MoveTo(ObjNr,Current.DB.ObjRec.Garbage);

Lock('Updating garbage');
Current.DB.ReadObj(ObjNr);
With Current.DB Do
  FillChar(ObjRec,SizeOf(ObjRec),#00);

With Current.DB.ObjRec Do
 Begin
 Name:='Garbage #'+Nr2Str(ObjNr);
 Key:='';
 Password:='';
 Owner:=Current.Player;
 End;
Current.DB.UpdateObj(ObjNr);
Unlock;

End;

Procedure Meta_Edit(Current : ContextType;InpStr : String);
Var Tmp : File;
    S   : SearchRec;
Begin
InpStr:=ChangePathTo(InpStr,TextPath);

If Not ExistFile(InpStr)
   Then Begin
        If Current.Level<GOD_Level
           Then Begin
                My_WriteLn('Textfile not found. Please contact your GOD');
                Exit;
                End
           Else Begin
                Assign(Tmp,InpStr);
                Rewrite(Tmp);
                Close(Tmp);
                If IoResult<>0 Then;
                End;
        End;
SwapVectors;
Exec(Editor,InpStr);
SwapVectors;
If Current.Level=GOD_Level
   Then Begin
        FindFirst(InpStr,AnyFile,S);
        If S.Size<=2
           Then Begin
                Erase(Tmp);
                If IoResult<>0 Then;
                End;
        End;
End;

End.